home *** CD-ROM | disk | FTP | other *** search
/ Turnbull China Bikeride / Turnbull China Bikeride - Disc 2.iso / STUTTGART / UNIXTOOL / GNU / TILEFORTH / TILE / TILE~ / !Tile / test / bitsets < prev    next >
Text File  |  1992-04-19  |  788b  |  36 lines
  1. .( Loading Bitsets test...) cr
  2.  
  3. #include <tile$lib>.blocks
  4. #include <tile$lib>.bitsets
  5.  
  6. bitsets blocks
  7.  
  8. bitset.type COLORS ( -- )
  9.   item white ( -- item)
  10.   item black ( -- item)
  11.   item blue ( -- item)
  12.   item red ( -- item)
  13.   item yellow ( -- item)
  14.   item green ( -- item)
  15.   item brown ( -- item)
  16.   item violet ( -- item)
  17. bitset.end
  18.  
  19. COLORS colors ( -- addr)
  20.  
  21. { yellow red blue }    constant primary
  22. { green brown violet } constant secondary
  23.  
  24. secondary .bitset COLORS cr
  25.  
  26. yellow empty-bitset add-bitset dup .bitset COLORS cr
  27. green swap add-bitset .bitset COLORS cr
  28. brown secondary remove-bitset .bitset COLORS cr
  29.  
  30. primary secondary union-bitset .bitset COLORS cr
  31. blue primary remove-bitset .bitset COLORS cr
  32.  
  33. { brown blue yellow } primary intersection-bitset .bitset COLORS cr
  34.  
  35. forth only
  36.